﻿<%
'''系统公用函数,由于本处还不能使用Sa对象、语言包,所以自定义函数请尽量不要放置在这里

'''根据正则代表式替换文本(多行模式)
'p_s:要进行替换的字符串
'p_p:正则表达式
'p_r:替换内容,支持正则捕获组
Function RegReplaceM(Byval p_s, Byval p_p, Byval p_r)
	RegReplaceM = ruleReplace_(p_s, p_p, p_r, 1)
End Function

'''底层生成一个指定长度的随机字符串
'''本函数为底层函数,外部请使用Rand\RandStr函数
'p_l:要返回的字符串长度
'p_s:在字符串中定义被允许的字符,默认为全部数字+(大小写)字母
Function randString_(Byval p_l, Byval p_s)
	Dim t_i
	If IsN(p_s) Then
		p_s = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
	End If
	For t_i = 1 To p_l
		Randomize(Timer()) : randString_ = randString_ & Mid(p_s, Int(Len(p_s) * Rnd() + 1), 1)
	Next
End Function

'''生成一个范围内随机数
'p_s:最小值
'p_b:最大值
Function Rand(Byval p_s, Byval p_b)
	Randomize(Timer()) : Rand = Int((p_b - p_s + 1) * Rnd() + p_s)
End Function

'''生成一个指定长度的随机字符串
'p_c:随机值的设置(字符串类型)
Function RandStr(Byval p_c)
	Dim t_a, t_p, t_l, t_t, t_rm, t_m, t_mi, t_ma
	p_c = Replace(Replace(Replace(p_c,"\<",Chr(0)),"\>",Chr(1)),"\:",Chr(2))
	t_a = ""
	If RegTest(p_c, "(<\d+>|<\d+-\d+>)") Then
		t_t = p_c
		t_p = Param(p_c)
		If Not IsN(t_p(1)) Then
			t_a = t_p(1) : t_t = t_p(0) : t_p = ""
		End If
		Set t_rm = RegMatch(p_c, "(<\d+>|<\d+-\d+>)")
		For Each t_m In t_rm
			t_p = t_m.SubMatches(0)
			t_l = Mid(t_p, 2, Len(t_p)-2)
			If RegTest(t_l, "^\d+$") Then
				t_t = Replace(t_t, t_p, randString_(t_l, t_a), 1, 1)
			Else
				t_mi = CLeft(t_l, "-")
				t_ma = CRight(t_l, "-")
				t_t = Replace(t_t, t_p, Rand(t_mi, t_ma), 1, 1)
			End If
		Next
		Set t_rm = Nothing
	ElseIf RegTest(p_c, "^\d+-\d+$") Then
		t_mi = CLeft(p_c, "-")
		t_ma = CRight(p_c, "-")
		t_t = Rand(t_mi, t_ma)
	ElseIf RegTest(p_c, "^(\d+)|(\d+:.)$") Then
		t_l = p_c : t_p = Param(p_c)
		If Not IsN(t_p(1)) Then
			t_a = t_p(1) : t_l = t_p(0) : t_p = ""
		End If
		t_t = randString_(t_l, t_a)
	Else
		t_t = p_c
	End If
	RandStr = Replace(Replace(Replace(t_t, Chr(0), "<"), Chr(1), ">"), Chr(2), ":")
End Function

'''HTML加码函数(显示为HTML阅读源码格式)
'p_s:源码字符串(HTML)
Function HtmlEncode(Byval p_s)
	If Has(p_s) Then
		p_s = Replace(p_s, Chr(38), "&#38;")
		p_s = Replace(p_s, "<", "&lt;")
		p_s = Replace(p_s, ">", "&gt;")
		p_s = Replace(p_s, Chr(39), "&#39;")
		p_s = Replace(p_s, Chr(32), "&nbsp;")
		p_s = Replace(p_s, Chr(34), "&quot;")
		p_s = Replace(p_s, Chr(9), "&nbsp;&nbsp; &nbsp;")
		p_s = Replace(p_s, vbCrLf, "<br />")
	End If
	HtmlEncode = p_s
End Function

'''HTML解码函数(显示为HTML源代码)
'p_s:字符串(加码转换后的字符串)
Function HtmlDecode(Byval p_s)
	If Has(p_s) Then
		p_s = RegReplace(p_s, "<br\p_s*/?\p_s*>", vbCrLf)
		p_s = Replace(p_s, "&nbsp;&nbsp; &nbsp;", Chr(9))
		p_s = Replace(p_s, "&quot;", Chr(34))
		p_s = Replace(p_s, "&nbsp;", Chr(32))
		p_s = Replace(p_s, "&#39;", Chr(39))
		p_s = Replace(p_s, "&apos;", Chr(39))
		p_s = Replace(p_s, "&gt;", ">")
		p_s = Replace(p_s, "&lt;", "<")
		p_s = Replace(p_s, "&amp;", Chr(38))
		p_s = Replace(p_s, "&#38;", Chr(38))
	End If
	HtmlDecode = p_s
End Function
	
'''过滤字符串中的HTML标签
'p_s:字符串(加码转换后的字符串)
Function HtmlFilter(Byval p_s)
	If Has(p_s) Then
		If IsN(p_s) Then
			HtmlFilter = "" : Exit Function
		End If
		p_s = RegReplace(p_s, "<[^>]+>", "")
		p_s = Replace(p_s, ">", "&gt;")
		p_s = Replace(p_s, "<", "&lt;")
	End If
	HtmlFilter = p_s
End Function

'''从左边截取指定数量的字符串，并以自定义的符号代替未显示部分
'p_s:待截取的字符串
'p_l:要保留的字数[:自定义的代替符号]
Function CutStr(ByVal p_s, ByVal p_l)
	If IsN(p_s) Then
		CutStr = "" : Exit Function
	End If
	If IsN(p_l) Or p_l = "0" Then
		CutStr = p_s : Exit Function
	End If
	Dim t_l, t_t, t_i, t_j, t_d, t_f, t_n
	p_s = Replace(p_s, vbCrLf, "")
	p_s = Replace(p_s, vbTab, "")
	t_l = Len(p_s) : t_t = 0 : t_d = ChrW(8230) : t_f = Param(p_l)
	If Instr(p_l, ":")>0 Then
		t_d = IfHas(t_f(1), "")
	End If
	p_l = Int(t_f(0)) : t_f = "" : t_n = 0
	For t_j = 1 To Len(t_d)
		t_n = IIF(Abs(Ascw(Mid(t_d,t_j,1)))>255, t_n+2, t_n+1)
	Next
	p_l = p_l - t_n
	For t_i = 1 To t_l
		t_t = IIF(Abs(Ascw(Mid(p_s,t_i,1)))>255, t_t+2, t_t+1)
		If t_t >= p_l Then
			t_f = Left(p_s, t_i) & t_d
			Exit For
		Else
			t_f = p_s
		End If
	Next
	CutStr = t_f
End Function

'''转换字符串为安全的JavaScript字符串
'p_s:要转换的字符串
Function JsEncode(ByVal p_s)
	If IsN(p_s) Then
		JsEncode = "" : Exit Function
	End If
	Dim t_a1, t_a2, t_i, t_j, t_c, t_p, t_t
	t_a1 = Array(&h27,&h22,&h5C,&h2F,&h08,&h0C,&h0A,&h0D,&h09)
	t_a2 = Array(&h27,&h22,&h5C,&h2F,&h62,&h66,&h6E,&h72,&h749)
	For t_i = 1 To Len(p_s)
		t_p = True
		t_c = Mid(p_s, t_i, 1)
		For t_j = 0 To Ubound(t_a1)
			If t_c = Chr(t_a1(t_j)) Then
				t_t = t_t & "\" & Chr(t_a2(t_j))
				t_p = False
				Exit For
			End If
		Next
		If t_p Then 
			Dim t_a
			t_a = AscW(t_c)
			If t_a > 31 And t_a < 127 Then
				t_t = t_t & t_c
			ElseIf t_a > -1 Or t_a < 65535 Then
				t_t = t_t & "\u" & String(4 - Len(Hex(t_a)), "0") & Hex(t_a)
			End If
		End If
	Next
	JsEncode = t_t
End Function
	
'''禁止页面缓存
'考虑移入ashapo
Sub NoCache()
	Response.Buffer = True
	Response.Expires = 0
	Response.ExpiresAbsolute = Now() - 1
	Response.CacheControl = "no-cache"
	Response.AddHeader "Expires",Date()
	Response.AddHeader "Pragma","no-cache"
	Response.AddHeader "Cache-Control","private, no-cache, must-revalidate"
End Sub

'''输出字符串后换行
Sub WC(Byval p_s)
	W(p_s & VbCrLf)
End Sub
	
'''实时显示字符串
Sub WF(Byval p_s)
	W(p_s)
	Response.Flush()
End Sub

'''输出字符串+br后换行
Sub WN(Byval p_s)
	W(p_s & "<br />" & VbCrLf)
End Sub
	
'''输出加码HTML后+br后换行
Sub WNH(Byval p_s)
	WN(HtmlEncode(p_s))
End Sub

'''输出二进制流字符串
Sub BW(Byval p_s)
	Response.BinaryWrite(p_s)
End Sub

'''安全POST
Function P(Byval p_s)
	Dim t_t, t_s : t_s = ""
	If Instr(p_s, ":")>0 Then
		t_t = CRight(p_s, ":") : p_s = CLeft(p_s, ":")
	End If
	t_s = Request.Form(p_s)
	P = S(t_s, t_t)
End Function

'''SQL过滤
Function Safe(Byval p_t, Byval p_p)
	Dim t_p, t_t, t_a, t_e, t_i
	t_e = False
	If p_t = 1 Then
		t_p = G(p_p)
	Else
		t_p = P(p_p)
	End If
	If IsNumeric(t_p) Then
		Safe = t_p
	Else
		Dim t_v : t_v = Lcase(t_p)
		t_t = " select | insert | delete |'| count(| drop | drop%20| drop%09| update | truncate | asc(| mid(| char(|"
		t_t = t_t &	" xp_cmdshell | exec | exec%20| exec%09| %20from | %09from |%20or |%09or | from | or | and |=|&"
		t_a = split(t_t,"|")
		For t_i=0 To Ubound(t_a)
			If Instr(t_v,t_a(t_i)) > 0 Then
				t_e = True
				Exit For
			End If
		Next
		If t_e Then
			Safe = ""
		Else
			Safe = t_p
		End If
	End If
End Function

'''安全Get
Function SG(Byval p_p)
	SG = Safe(1, p_p)
End Function

'''安全Post
Function SP(Byval p_p)
	SP = Safe(0, p_p)
End Function

'''按Unicode编码用%编码特殊字符串
'p_s:待编码的字符串
Function Escape(Byval p_s)
	If IsN(p_s) Then
		Escape = "" : Exit Function
	End If
	Dim t_i,t_c,t_a,t_s : t_s = ""
	For t_i = 1 To Len(p_s)
		t_c = Mid(p_s,t_i,1)
		t_a = ASCW(t_c)
		If (t_a>=48 And t_a<=57) Or (t_a>=65 And t_a<=90) Or (t_a>=97 And t_a<=122) Then
			t_s = t_s & t_c
		ElseIf InStr("@*_+-./",t_c)>0 Then
			t_s = t_s & t_c
		ElseIf t_a>0 And t_a<16 Then
			t_s = t_s & "%0" & Hex(t_a)
		ElseIf t_a>=16 And t_a<256 Then
			t_s = t_s & "%" & Hex(t_a)
		Else
			t_s = t_s & "%u" & Hex(t_a)
		End If
	Next
	Escape = t_s
End Function

'''把用Unicode编码的特殊字符解码为普通字符串
'p_s:待解码的字符串
Function UnEscape(ByVal p_s)
	If IsN(p_s) Then
		UnEscape = "" : Exit Function
	End If
	Dim t_x, t_s
	t_x = InStr(p_s,"%")
	t_s = ""
	Do While t_x>0
		t_s = t_s & Mid(p_s,1,t_x-1)
		If LCase(Mid(p_s,t_x+1,1))="u" Then
			t_s = t_s & ChrW(CLng("&H"&Mid(p_s,t_x+2,4)))
			p_s = Mid(p_s,t_x+6)
		Else
			t_s = t_s & Chr(CLng("&H"&Mid(p_s,t_x+1,2)))
			p_s = Mid(p_s,t_x+3)
		End If
		t_x=InStr(p_s,"%")
	Loop
	UnEscape = t_s & p_s
End Function
%>